home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / GW AdaEd 1.4.2 / GWAdaDemos / GWU Demos / windows.adb < prev    next >
Encoding:
Text File  |  1993-10-09  |  3.9 KB  |  136 lines  |  [TEXT/GADA]
  1. WITH Text_IO, Screen;
  2. PACKAGE BODY Windows IS
  3.  
  4.   FUNCTION Open (UpperLeft: Screen.Position;
  5.                  Height   : Screen.Height;
  6.                  Width    : Screen.Width) RETURN Window IS
  7.     Result: Window;
  8.   BEGIN
  9.     Result.Current:= UpperLeft;
  10.     Result.First  := UpperLeft;
  11.     Result.Last   := (Row    => UpperLeft.Row + Height - 1, 
  12.                       Column => UpperLeft.Column + Width - 1);
  13.     RETURN Result; 
  14.   END Open;
  15.  
  16.   PROCEDURE EraseToEndOfLine (W : IN OUT Window) IS
  17.   BEGIN
  18.     Screen.MoveCursor (W.Current);
  19.     FOR Count IN W.Current.Column .. W.Last.Column LOOP
  20.       Text_IO.Put (' ');
  21.     END LOOP;
  22.     Screen.MoveCursor (W.Current);
  23.   END EraseToEndOfLine;
  24.  
  25.   PROCEDURE Put (W  : IN OUT Window;
  26.                  Ch : IN CHARACTER) IS
  27.   BEGIN
  28.  
  29.     -- If at end of current line, move to next line 
  30.     IF W.Current.Column > W.Last.Column THEN
  31.       IF W.Current.Row = W.Last.Row THEN
  32.         W.Current.Row := W.First.Row;
  33.       ELSE
  34.         W.Current.Row := W.Current.Row + 1;
  35.       END IF;
  36.       W.Current.Column := W.First.Column;
  37.     END IF;
  38.  
  39.     -- If at First char, erase line
  40.     IF W.Current.Column = W.First.Column THEN
  41.       EraseToEndOfLine (W);
  42.     END IF;
  43.  
  44.     Screen.MoveCursor (To => W.Current);
  45.  
  46.      -- here is where we actually write the character!
  47.      Text_IO.Put (Ch);
  48.      W.Current.Column := W.Current.Column + 1;
  49.  
  50.   END Put;
  51.  
  52.   PROCEDURE Put (W : IN OUT Window;
  53.                  S : IN String) IS
  54.   BEGIN
  55.     FOR Count IN S'Range LOOP
  56.       Put (W, S (Count));
  57.     END LOOP;
  58.   END Put;
  59.  
  60.   PROCEDURE New_Line (W : IN OUT Window) IS
  61.   BEGIN
  62.     IF W.Current.Column = 1 THEN
  63.       EraseToEndOfLine (W);
  64.     END IF;
  65.     IF W.Current.Row = W.Last.Row THEN
  66.       W.Current.Row := W.First.Row;
  67.     ELSE
  68.       W.Current.Row := W.Current.Row + 1;
  69.     END IF;
  70.     W.Current.Column := W.First.Column;
  71.   END New_Line;
  72.  
  73.   PROCEDURE Title (W     : IN OUT Window;
  74.                    Name  : IN String;
  75.                    Under : IN Character) IS
  76.   BEGIN
  77.     -- Put name on top line
  78.     W.Current := W.First;
  79.     Put (W, Name);
  80.     New_Line (W);
  81.     -- Underline name if desired, and reduce the writable area
  82.     -- of the window by one line
  83.     IF Under = ' ' THEN   -- no underlining
  84.       W.First.Row := W.First.Row + 1;      
  85.     ELSE                  -- go across the row, underlining
  86.       FOR Count IN W.First.Column..W.Last.Column LOOP 
  87.         Put (W, Under);
  88.       END LOOP;
  89.       New_Line (W);
  90.       W.First.Row := W.First.Row + 2; -- reduce writable area
  91.     END IF;
  92.   END Title;
  93.  
  94.   PROCEDURE Borders (W                    : IN OUT Window;
  95.                      Corner, Down, Across : IN Character) IS
  96.   BEGIN
  97.     -- Put top line of border
  98.     Screen.MoveCursor (W.First);
  99.     Text_IO.Put (Corner);
  100.     FOR Count IN W.First.Column + 1 .. W.Last.Column - 1 LOOP
  101.       Text_IO.Put (Across);
  102.     END LOOP;
  103.     Text_IO.Put (Corner);
  104.  
  105.     -- Put the two side lines
  106.     FOR Count IN W.First.Row + 1 .. W.Last.Row - 1 LOOP
  107.       Screen.MoveCursor ((Row => Count, Column => W.First.Column));
  108.       Text_IO.Put (Down);
  109.       Screen.MoveCursor ((Row => Count, Column => W.Last.Column));
  110.       Text_IO.Put (Down);
  111.     END LOOP;
  112.  
  113.     -- Put the bottom line of the border
  114.     Screen.MoveCursor ((Row => W.Last.Row, Column => W.First.Column));
  115.     Text_IO.Put (corner);
  116.     FOR Count IN W.First.Column + 1 .. W.Last.Column - 1 LOOP
  117.       Text_IO.Put (Across);
  118.     END LOOP;
  119.     Text_IO.Put (Corner);
  120.  
  121.     -- Make the Window smaller by one character on each side
  122.     W.First  := (Row => W.First.Row  + 1, Column => W.First.Column  + 1);
  123.     W.Last   := (Row => W.Last.Row - 1,   Column => W.Last.Column - 1);
  124.     W.Current    := W.First;
  125.   END Borders;
  126.  
  127.   PROCEDURE MoveCursor (W : IN OUT Window;
  128.                         P : IN Screen.Position) IS
  129.     -- Relative to writable Window boundaries, of course
  130.   BEGIN
  131.     W.Current.Row    := W.First.Row + P.Row;
  132.     W.Current.Column := W.First.Column + P.Column;
  133.   END MoveCursor;
  134.  
  135. END Windows;
  136.